home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue62 / WStrings / wideinfo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-08-10  |  6.4 KB  |  170 lines
  1. unit WideInfo;
  2.  
  3. interface
  4.  
  5. uses TypInfo;
  6.  
  7. // GetWideStrProp gets a WideString property value.
  8. // SetWideStrProp sets a WideString property value.
  9. function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
  10. procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
  11.  
  12. // GetWideStrProp and SetWideStrProp require low-level access to
  13. // PropInfo. GetPropGetter and GetPropSetter provide that access by
  14. // obtaining the pointer where the property value is stored. These
  15. // procedure work for any type of property.
  16. //
  17. // When PtrType is ptData, Ptr is a pointer to the property value as
  18. // stored in a field of Instance. Cast Ptr to the correct type to fetch
  19. // or modify the value.
  20. //
  21. // When PtrType is ptCode, Ptr is a code pointer to a method that
  22. // gets or sets the value. Instance is the data part of the method.
  23. // Call the method to get or set the value. Note that if PropInfo.Index
  24. // is not equal to Low(Integer) (that is, $80000000), the property is
  25. // an indexed property, so you must pass the index value as the first
  26. // argument (after Self). Cast Ptr to the appropriate function type.
  27. // The getter return type must match the property type. The setter
  28. // procedure's last parameter type must match the property type.
  29. type
  30.   TPtrType = (ptCode, ptData);
  31. procedure GetPropGetter(Instance: TObject; PropInfo: PPropInfo; var PtrType: TPtrType; var Ptr: Pointer);
  32. procedure GetPropSetter(Instance: TObject; PropInfo: PPropInfo; var PtrType: TPtrType; var Ptr: Pointer);
  33.  
  34. implementation
  35.  
  36. uses Consts, SysUtils;
  37.  
  38. resourcestring
  39.   sWriteOnlyProperty = 'Property is write-only';
  40.   
  41. const
  42.   NoIndex = Low(Integer);
  43. type
  44.   TWideStrProc = procedure(Instance: TObject; const Value: WideString) register;
  45.   TWideStrIndexProc = procedure(Instance: TObject; Index: Integer; const Value: WideString) register;
  46.   TWideStrFunc = function(Instance: TObject): WideString register;
  47.   TWideStrIndexFunc = function(Instance: TObject; Index: Integer): WideString register;
  48.   PPChar = ^PChar;
  49.   PPointer = ^Pointer;
  50.  
  51. // To help access the property value, GetPropValue gets a pointer
  52. // to the field or method. The PtrType parameter says what kind of
  53. // pointer it is. An exception is raised for any error.
  54. procedure GetPropGetter(Instance: TObject; PropInfo: PPropInfo; var PtrType: TPtrType; var Ptr: Pointer);
  55. var
  56.   Mask: LongWord;
  57. begin
  58.   // The high byte of GetProc determines how to interpret it.
  59.   Mask := LongWord(PropInfo.GetProc) and $FF000000;
  60.   if Mask = $FF000000 then
  61.   begin
  62.     // GetProc is a field offset in Instance. The low-order 3 bytes
  63.     // specify the byte offset from the start of Instance. Treat
  64.     // Instance as a pointer to add the offset, then dereference
  65.     // that pointer to perform the simple WideString assignment.
  66.     PtrType := ptData;
  67.     Ptr := PChar(Instance) + LongInt(PropInfo.GetProc) and $FFFFFF;
  68.   end
  69.   else
  70.   begin
  71.     // Otherwise, GetProc is a reference to a method, either virtual or static.
  72.     PtrType := ptCode;
  73.     if Mask = $FE000000 then
  74.     begin
  75.       // GetProc is a virtual function offset. Only the low-order 2 bytes
  76.       // are used for the offset into the VMT.
  77.       // The first field in Instance is a pointer to a VMT, which is a list
  78.       // of pointers to functions. Use the offset into the VMT to get the
  79.       // actual method pointer.
  80.       Ptr := PPChar(Instance)^ + LongRec(PropInfo.GetProc).Lo;
  81.       Ptr := PPointer(Ptr)^;
  82.     end
  83.     else
  84.     begin
  85.       // GetProc is a static method pointer.
  86.       Ptr := PropInfo.GetProc;
  87.       if Ptr = nil then
  88.         // No GetProc at all!
  89.         raise EPropWriteOnly.Create(sWriteOnlyProperty);
  90.     end;
  91.   end;
  92. end;
  93.  
  94. procedure GetPropSetter(Instance: TObject; PropInfo: PPropInfo; var PtrType: TPtrType; var Ptr: Pointer);
  95. var
  96.   Mask: LongWord;
  97. begin
  98.   // The high byte of SetProc determines how to interpret it.
  99.   Mask := LongWord(PropInfo.SetProc) and $FF000000;
  100.   if Mask = $FF000000 then
  101.   begin
  102.     // SetProc is a field offset in Instance. The low-order 3 bytes
  103.     // specify the byte offset from the start of Instance. Treat
  104.     // Instance as a pointer to add the offset, then dereference
  105.     // that pointer to perform the simple WideString assignment.
  106.     PtrType := ptData;
  107.     Ptr := PChar(Instance) + LongInt(PropInfo.SetProc) and $FFFFFF;
  108.   end
  109.   else
  110.   begin
  111.     // Otherwise, SetProc is a reference to a method, either virtual or static.
  112.     PtrType := ptCode;
  113.     if Mask = $FE000000 then
  114.     begin
  115.       // SetProc is a virtual function offset. Only the low-order 2 bytes
  116.       // are used for the offset into the VMT.
  117.       // The first field in Instance is a pointer to a VMT, which is a list
  118.       // of pointers to functions. Use the offset into the VMT to get the
  119.       // actual method pointer.
  120.       Ptr := PPChar(Instance)^ + LongRec(PropInfo.SetProc).Lo;
  121.       Ptr := PPointer(Ptr)^;
  122.     end
  123.     else
  124.     begin
  125.       // SetProc is a static method pointer.
  126.       Ptr := PropInfo.SetProc;
  127.       if Ptr = nil then
  128.         // No SetProc at all!
  129.         raise EPropReadOnly.Create(sReadOnlyProperty);
  130.     end;
  131.   end;
  132. end;
  133.  
  134. // Delphi always converts a wide string to an ANSI string when setting
  135. // a property value. Call GetWideStrProp and SetWideStrProp to access
  136. // the property value as a real WideString.
  137. function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
  138. var
  139.   PtrType: TPtrType;
  140.   Ptr: Pointer;
  141. begin
  142.   GetPropGetter(Instance, PropInfo, PtrType, Ptr);
  143.   if PtrType = ptData then
  144.     Result := PWideString(Ptr)^
  145.   else if PropInfo.Index <> NoIndex then
  146.     // Indexed property, so call the GetProc with the index value.
  147.     Result := TWideStrIndexFunc(Ptr)(Instance, PropInfo.Index)
  148.   else
  149.     // Not an indexed property, so just call the GetProc.
  150.     Result := TWideStrFunc(Ptr)(Instance);
  151. end;
  152.  
  153. procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
  154. var
  155.   PtrType: TPtrType;
  156.   Ptr: Pointer;
  157. begin
  158.   GetPropSetter(Instance, PropInfo, PtrType, Ptr);
  159.   if PtrType = ptData then
  160.     PWideString(Ptr)^ := Value
  161.   else if PropInfo.Index <> NoIndex then
  162.     // Indexed property, so call the SetProc with the index value.
  163.     TWideStrIndexProc(Ptr)(Instance, PropInfo.Index, Value)
  164.   else
  165.     // Not an indexed property, so just call the SetProc.
  166.     TWideStrProc(Ptr)(Instance, Value);
  167. end;
  168.  
  169. end.
  170.